www.gusucode.com > 因特达企业管理系统 V2010 > 因特达企业管理系统 V2010\code\wwwroot\index.asp
<%
if is_netbox=true then
response.buffer=false
end if
server.ScriptTimeout =1800'30分钟
select case request("exe")
case "setup"
call setup1
response.Write("<script>s(297,99,'正在安装数据库')</script>")
call setup2
response.Write("<script>s(300,100,'安装完毕 <a href=index.asp>开始使用</a>')</script>")
response.write("<script>parent.setuping=0</script>")
case else
call main
end select
function is_netbox()
on error resume next
err.clear
Set ds = CreateObject("NetBox")
if err=0 then
is_netbox=true
else
is_netbox=false
end if
end function
%>
<%sub main%>
<html xmlns:v="urn:schemas-microsoft-com:vml" xmlns:o="urn:schemas-microsoft-com:office:office">
<style type="text/css">
<!--
body {
background-color: #62798E;
}
.STYLE1 {
color: #000000;
font-size: 36px;
font-family: "黑体";
font-weight: bolder;
}
.but {
height: 30px;
}
.STYLE3 {color: #666666}
.b1 {
border: 1px solid #577D9F;
background-color: #FFFFFF;
}
#info1 {
color: #FFFFFF;
background-color: #316AC5;
}
-->
</style>
<script>
function setup()
{
if (form1.bm.value=="")
{
alert('编码不能为空')
return
}
form1.style.display="none"
info.style.display=""
setuping=1
form1.submit()
}
</script>
<div id=div_loading>
<STYLE>
v\:*{behavior:url(#default#VML);}
*{font-size:12px;color:;}
</STYLE>
<body>
<table width="100%" height="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td align="center" >
<v:RoundRect id='a' style='position:a bsolute;left:0;top:0;width:500;height:300;text-align:center'>
<v:Textbox inset='5px,5px,5px'><font id='jindu'>
<table width="100%" height="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td height="36" class="STYLE1">程序安装</td>
</tr>
<tr>
<td height="90%" align="center">
<table id=info style="display:none" width="300" border="0" cellspacing="0" cellpadding="0">
<tr>
<td class="b1"><div align="center" id=info1 style="width: 1px;" ></div></td>
</tr>
<tr>
<td> </td>
</tr>
<tr>
<td id=info2> </td>
</tr>
</table>
<form action="index.asp?exe=setup" method="post" name="form1" target="blank" id="form1">
<table width="324" border="0" cellspacing="0" cellpadding="3">
<tr>
<td width="91" align="right">公 司 名：</td>
<td width="148"><input name="comName" type="text" id="comName" value="xxxxxxxxxxxx公司" size="22" /></td>
<td width="85" nowrap class="STYLE3">填你的公司名</td>
</tr>
<tr>
<td align="right" nowrap>输入编码： </td>
<td><input name="bm" type="text" id="bm" value="yinteda" onKeyUp="this.value=this.value.replace(/[^a-zA-Z0-9]/g,'')" size="22" /></td>
<td><span class="STYLE3">填字母或数字 </span></td>
</tr>
<tr>
<td height="55" align="right"> </td>
<td align="right"><span class="STYLE3">
<input name="button" type="button" class="but" onClick="setup()" value="开始安装" />
<input name="button2" type="button" class="but" onClick="window.close()" id="button2" value=" 关闭 ">
</span></td>
<td align="center"> </td>
</tr>
</table>
<p><br />
</p>
</form></td>
</tr>
</table>
</font></v:textbox>
<v:fill type='gradient' id='fill1' color='blue'/>
</v:RoundRect><iframe name=blank width=0 height=0></iframe>
</td>
</tr>
</table>
<script>
var setuping=0
var pos1=1,posall=100 //定义全局变量,pos1为当前进度,posall为总进度
function play1(){ //播放函数
if (setuping!=0)
{
if(pos1<posall)pos1+=1;else{pos1=1;fill1.color="rgb("+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+")"}
fill1.angle=Math.round(300/(posall/pos1)) // setTimeout("play1()",40)//40毫秒播放一次，一般CPU保证能消化~~~
}
}
setInterval("play1()",40)
</script>
</div>
</body>
</html>
<%end sub%>
<%
sub setup1
%>
<script>
function s(w,s1,s2)
{
parent.info1.style.width=w
parent.info1.innerText=s1+"%"
parent.info2.innerHTML=s2
}
</script>
<%
dim fso
rarstr="driver={microsoft access driver (*.mdb)};DBQ="+server.mappath("data1.asp")
set conn=server.createobject("adodb.connection")
set rs=server.CreateObject("adodb.recordset")
conn.open rarstr
set rar=server.CreateObject("adodb.recordset")
rar.open "select * from f ",conn,1,1
'response.Write(rar.recordcount)
'response.End()
on error resume next
for i=1 to rar.recordcount
set fso=server.createobject("scripting.filesystemobject")
fn=server.MapPath(rar("f"))
arr=split(fn,"\")'建立目录
folder=arr(0)
if ubound(arr)>1 then
for j=1 to ubound(arr)-1
folder=folder&"\"&arr(j)
if fso.folderExists(folder)=false then'文件夹不存在
fso.CreateFolder(folder)'建立 文件夹
'if err<>0 then
' response.write "rar_f:"&rar("f")&"<br>fn:"&fn&"<br>folder:"&folder
' response.End()
' end if
end if
next
end if
'response.End()
if fso.fileexists(fn) then fso.deletefile(fn) end if
set fso=nothing
rs.open "select * from c where id="&rar("cid"),conn,1,1
set s2=server.createobject("adodb.stream")'写入文件
s2.open
s2.type=1
s2.position=0
fc=rs("c").getChunk(20000000)'从数据库中取文件
s2.write(fc)
s2.seteos
s2.savetofile(fn)
rs.close
bili=int(i/rar.recordcount*100)
width=bili*3
response.Write("<script>s("&width&","&bili&",'提取文件："&rar("f")&"')</script>")
if is_netbox=false then
response.Flush()
end if
rar.movenext
next
conn.close
set conn=nothing
end sub
sub setup2
copy_file "data2.asp","crm\data\global.asa"
copy_file "data2.asp","crm\data\"&request("bm")&"\global.asa"
copy_file "data3.asp","crm\admin\"&get_db_path()&"\global.asa"
copy_file "data4.asp","crm\admin\sqlin\db\global.asa"
copy_file "0","crm\document\com\"&request("bm")&"\0"'
rarstr="driver={microsoft access driver (*.mdb)};DBQ="+server.mappath("crm\admin\"&get_db_path()&"\global.asa")
set conn=server.createobject("adodb.connection")
set rs=server.CreateObject("adodb.recordset")
conn.open rarstr
sql="select * from 公司名单"
rs.open sql,conn,3,3
rs.addnew
rs("comName")=(request("comName"))
rs("公司简称")=(request("bm"))
rs("db_type")="access"
rs("开通状态")="开通"
rs("tel")=request("tel")
rs("beizhu")=request("beizhu")
rs("加入时间")=now()
rs.update
del_file "data2.asp"
del_file "data3.asp"
del_file "data4.asp"
end sub
function copy_file(byval from_file,byval to_file)
dim fso,arr,i,folder
on error resume next
set fso=server.createobject("scripting.filesystemobject")
from_file=server.MapPath(from_file)
to_file =server.MapPath(to_file)'如：d:/web/crm2008_ok/crm/index.asp
'if err<>0 then
' response.write to_file
' response.end
' end if
arr=split(to_file,"\")'建立目录
folder=arr(0)
for i=1 to ubound(arr)-1
folder=folder&"/"&arr(i)
if fso.folderExists(folder)=false then'文件夹不存在
fso.CreateFolder(folder)'建立 文件夹
end if
next
fso.copyFile from_file,to_file,false'true为覆盖已有文件
end function
function del_file(f)
dim fso
on error resume next
set fso=server.createobject("scripting.filesystemobject")
fso.deleteFile server.MapPath(f)'true为覆盖已有文件
end function
function get_db_path()'现在有的路径 ，以前老的数据库名
on error resume next
dim fso,folder_s,folder_a,db_forder
set fso=server.createobject("scripting.filesystemobject")
set folder_s=fso.getfolder(server.MapPath("crm/admin"))
dim arr
for each folder_a in folder_s.subfolders
arr=split(folder_a,"\")
folder_a_1=arr(ubound(arr))
if left(folder_a_1,4)="db__" then'左边几位相同,如db__swekldshrellsd,这里的+2是因为:db目录用db加双下划线加密码分开的。
db_folder=folder_a_1
exit for
end if
' response.Write("<br>a:")&folder_a_1
' response.Write("<br>old:")&folder_old
next
'response.End()
if db_folder="" then'说明还没有这文件夹,那就把以前的文件夹改名
db_folder="db"
end if
get_db_path=db_folder
end function
%>